home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Language/OS - Multiplatform Resource Library
/
LANGUAGE OS.iso
/
lisp
/
eulisp
/
mpfeel.lha
/
MPFeel
/
system.c
< prev
next >
Wrap
C/C++ Source or Header
|
1992-10-06
|
14KB
|
681 lines
/* ******************************************************************** */
/* system.c Copyright (C) Codemist and University of Bath 1989 */
/* */
/* Environment specific code */
/* ******************************************************************** */
/*
* $Id: system.c,v 1.4 1992/02/10 12:01:10 pab Exp $
*
* $Log: system.c,v $
* Revision 1.4 1992/02/10 12:01:10 pab
* Gc on/off fixes
*
* Revision 1.3 1992/01/29 13:49:07 pab
* sysV fixes
*
* Revision 1.2 1991/09/11 12:07:46 pab
* 11/9/91 First Alpha release of modified system
*
* Revision 1.1 1991/08/12 16:50:06 pab
* Initial revision
*
* Revision 1.9 1991/05/16 11:29:26 pab
* 'C' garbage collector additions
*
* Revision 1.8 1991/05/15 20:09:53 kjp
* Tidied suignal handling.
*
* Revision 1.7 1991/04/02 16:42:03 kjp
* BSD signal support.
*
* Revision 1.6 1991/02/28 13:53:54 kjp
* Fixed semaphore interaction with GC and sysv signalling.
*
* Revision 1.5 1991/02/13 18:25:46 kjp
* Pass.
*
*/
#define SCHEDBUG(x)
/*
* Change Log:
* Version 1, April 1990
*/
/*
* This file (and it's accompanying '.h') are intended to encapsulate all
* of the system specific requirements of FEEL. For each target system
* there must be a set of functions conforming to the requested
* configuration (e.g. if threads are required, the thread operations
* must exist along with their defined types - otherwise, they may be
* omitted).
* It is expected that this file may degenerate into hash-includes.
*/
#include <signal.h>
#include "funcalls.h"
#include "defs.h"
#include "structs.h"
#include "global.h"
#include "error.h"
#include "state.h"
#include "allocate.h"
#include "garbage.h"
#include "threads.h"
/*
* Nasty signal hackery!
*/
#ifdef WITH_BSD_SIGNALS
#define sighold(sig) sigmask(sig)
#define sigset(sig,func) signal(sig,func)
#define my_sigpause(sig) sigpause(0)
#else
#define my_sigpause(sig) sigpause(sig)
#endif
/*
* For a system to run with threads, the following must be provided:
*
* Types:
* SystemSemaphore
*
* Functions:
*
* char* system_malloc(int)
* char* system_static_malloc(int)
*
* void system_allocate_semaphore(SystemSemaphore *)
* void system_initialise_semaphore(SystemSemaphore *)
* void system_open_semaphore(SystemSemaphore *)
* void system_close_semaphore(SystemSemaphore *)
*
*/
SYSTEM_THREAD_SPECIFIC_DECLARATION(int,system_scheduler_number);
int system_running_processors = 1; /* Unless initialised otherwise */
/*
* Stack checking...
*/
#define THREAD_STACK_MARGIN (3*1024)
#define THREAD_GC_STACK_MARGIN (512)
static SYSTEM_GLOBAL(int,system_control_c_flag);
/* C-c interrupt handler... */
static void system_reenter_toplevel(LispObject *stacktop, int sig)
{
IGNORE(sig);
SYSTEM_GLOBAL_VALUE(system_control_c_flag) = FALSE;
CallError(stacktop,"User Interrupt!",nil,NONCONTINUABLE);
}
static void system_control_catcher(int sig)
{
IGNORE(sig);
if (SYSTEM_GLOBAL_VALUE(system_control_c_flag)) {
fprintf(stderr,"Go away and leave me alone!\n");
fflush(stderr);
signal(02,system_control_catcher); /* Reinstall */
return;
}
SYSTEM_GLOBAL_VALUE(system_control_c_flag) = TRUE;
signal(02,system_control_catcher); /* Reinstall */
}
int system_stacks_ok_p(LispObject *stacktop, LispObject form)
{
extern LispObject interpreter_thread;
int handle;
if (SYSTEM_GLOBAL_VALUE(system_control_c_flag))
system_reenter_toplevel(stacktop,0);
/*
if (CURRENT_THREAD() != (LispObject) interpreter_thread) {
fprintf(stderr,"{%d%%}",
((int) &handle - (int) STACK_BASE())*100
/ CURRENT_THREAD()->THREAD.stack_size);
fflush(stderr);
}
*/
#ifndef MACHINE_ANY
if ((int) &handle - (int) (STACK_BASE()) < THREAD_STACK_MARGIN)
CallError(stacktop,"SYSTEM: C stack overflowing",form,NONCONTINUABLE);
#endif
if ((CURRENT_THREAD())->THREAD.gc_stack_size
- (int) (GC_STACK_POINTER()-GC_STACK_BASE()) * sizeof(LispObject)
< THREAD_GC_STACK_MARGIN)
{
CallError(stacktop,"SYSTEM: GC stack overflowing",form,NONCONTINUABLE);
}
return(TRUE);
}
/* ******************************************************************** */
/* Any Machine */
/* ******************************************************************** */
#ifdef MACHINE_ANY
#ifndef CGC
char *system_malloc(int n)
{
char *sbrk(int);
char *addr;
if ((addr = (char *) sbrk(n)) == (char *) -1) {
perror("INITERROR: unable to allocate enough memory from system\n");
system_lisp_exit(1);
}
return(addr);
}
char *system_static_malloc(int n)
{
char *sbrk(int);
char *addr;
if ((addr = (char *) sbrk(n)) == (char *) -1) {
perror("INITERROR: out of static memory\n");
system_lisp_exit(1);
}
return(addr);
}
#endif
void system_lisp_exit(int n)
{
exit(n);
}
void system_abort(int sig)
{
fprintf(stderr,"\n\nAborting feel on signal %d\n\n",sig);
exit(sig);
}
void runtime_initialise_system()
{
system_scheduler_number = 0;
#ifdef CGC
gc_init();
#endif
#ifdef TRAP_ALL
signal(15,system_abort);
signal(11,system_abort);
signal(10,system_abort);
signal(02,system_control_catcher);
#endif
SYSTEM_INITIALISE_GLOBAL(int,system_control_c_flag,FALSE);
}
#endif
/* ******************************************************************** */
/* BSD */
/* ******************************************************************** */
#ifdef MACHINE_BSD
/*
* Memory allocation...
*/
char *system_malloc(int n)
{
char *sbrk(int);
char *addr;
if ((addr = (char *) sbrk(n)) == (char *) -1) {
perror("INITERROR: unable to allocate enough memory from system\n");
system_lisp_exit(1);
}
return(addr);
}
#define STATIC_MALLOC_HUNK_SIZE (4096)
char *static_free_ptr;
int static_free_count;
char *system_static_malloc(int n)
{
char *val;
n = n + (n%BYTE_ALIGNMENT == 0 ? n : (BYTE_ALIGNMENT-n%BYTE_ALIGNMENT));
/* Alignment.. */
if (static_free_count < n) {
char *new;
if ((new = system_malloc(STATIC_MALLOC_HUNK_SIZE)) == NULL) {
fprintf(stderr,"INIT ERR: out of static memory\n");
exit(1);
}
static_free_ptr = new;
static_free_count = STATIC_MALLOC_HUNK_SIZE;
}
val = static_free_ptr;
static_free_ptr = val + n;
static_free_count -= n;
return(val);
}
/*
* Semaphores... (in header - dummies)
*/
/*
* Signal handling...
*/
/* Bad news signal handler... */
void system_abort(int sig)
{
fprintf(stderr,"\n\nAborting EuLisp on signal %d... ",sig);
fprintf(stderr,"done\n\n");
exit(1);
}
/*
* Init and cleanup...
*/
void system_lisp_exit(int n)
{
exit(n);
}
void system_sleep_until_kicked() {}
void system_kick_sleepers() {}
void system_register_process(int pid) {IGNORE(pid);}
void runtime_initialise_system()
{
signal(15,system_abort); /* Catch terminations */
/*
signal(11,system_abort);
signal(10,system_abort);
*/
signal(02,system_control_catcher); /* C-c with any luck */
system_scheduler_number = 0;
#ifdef CGC
gc_init();
#endif
SYSTEM_INITIALISE_GLOBAL(int,system_control_c_flag,FALSE);
}
#endif
/* ******************************************************************** */
/* System V */
/* ******************************************************************** */
#ifdef MACHINE_SYSTEMV
/*
* Memory allocation...
*/
/* Of shared memory segments... */
#define MAX_SHARED_SEGMENTS 100
int shared_ids[MAX_SHARED_SEGMENTS];
int shared_segment_count;
char *system_malloc(int n)
{
int seg;
char *addr;
if (shared_segment_count >= MAX_SHARED_SEGMENTS) {
fprintf(stderr,"Can't allocate shared segment\n");
system_lisp_exit(1);
}
if ((seg = shmget(IPC_PRIVATE,n,511|IPC_CREAT)) < 0) {
perror("shmget\n");
system_lisp_exit(1);
}
if ((int) (addr = shmat(seg,NULL,NULL)) == -1) {
perror("shmat\n");
system_lisp_exit(1);
}
shared_ids[shared_segment_count] = seg;
++shared_segment_count;
return(addr);
}
/* Of static shared bits (assumes serial for now)... */
#define STATIC_MALLOC_HUNK_SIZE (4096)
char *static_free_ptr;
int static_free_count;
char *system_static_malloc(int n)
{
char *val;
n = n + (n%BYTE_ALIGNMENT == 0 ? n : (BYTE_ALIGNMENT-n%BYTE_ALIGNMENT));
/* Alignment.. */
if (static_free_count < n) {
char *new;
if ((new = system_malloc(STATIC_MALLOC_HUNK_SIZE)) == NULL) {
fprintf(stderr,"INIT ERR: out of static memory\n");
system_lisp_exit(1);
}
static_free_ptr = new;
static_free_count = STATIC_MALLOC_HUNK_SIZE;
}
val = static_free_ptr;
static_free_ptr = val + n;
static_free_count -= n;
return(val);
}
/*
* Semaphores...
*/
void system_initialise_semaphore(SystemSemaphore *ptr)
{
*ptr = 1;
}
void system_allocate_semaphore(SystemSemaphore *ptr)
{
*ptr = 1;
}
/* SystemV Semaphores excluded */
#ifdef SEMAPHORES_SOFTWARE
#include "lamport.h"
LamportSemaphore system_semaphore;
void system_open_semaphore(LispObject *stacktop, SystemSemaphore *ptr)
{
extern SYSTEM_GLOBAL(SystemSemaphore,GC_sem);
int mine_flag = FALSE;
top:
lamport_enter(system_semaphore,system_scheduler_number);
if (*ptr == 1) {
*ptr = 0;
mine_flag = TRUE;
}
lamport_exit(system_semaphore,system_scheduler_number);
if (mine_flag) return;
if (ptr != &SYSTEM_GLOBAL_VALUE(GC_sem))
while (*ptr != 1) GC_sync_test();
else
while (*ptr != 1);
goto top;
}
int system_maybe_open_semaphore(LispObject *stacktop,SystemSemaphore *ptr)
{
int mine_flag = FALSE;
lamport_enter(system_semaphore,system_scheduler_number);
if (*ptr == 1) {
*ptr = 0;
mine_flag = TRUE;
}
lamport_exit(system_semaphore,system_scheduler_number);
GC_sync_test();
return(mine_flag);
}
#endif
void system_close_semaphore(SystemSemaphore *ptr)
{
*ptr = 1;
}
/*
* Signal handling...
*/
static SYSTEM_GLOBAL_ARRAY1(int,system_pids,MAX_PROCESSORS);
/* Bad news, free up semaphores and shared memory... */
void system_abort(int sig)
{
int i;
fprintf(stderr,"\n\nAborting EuLisp on signal %d... ",sig);
for (i=0;i<shared_segment_count;++i) {
(void) shmctl(shared_ids[i],IPC_RMID,NULL);
}
(void) semctl(system_semaphore,NULL,IPC_RMID,NULL);
/* Kill of other processes too */
for (i=0; i<RUNNING_PROCESSORS(); ++i)
if (i != system_scheduler_number)
kill(SYSTEM_GLOBAL_ARRAY1_VALUE(system_pids,i),SIGQUIT);
fprintf(stderr,"done\n\n");
exit(1);
}
/*
* Init and cleanup...
*/
void system_lisp_exit(int n)
{
int i;
for (i=0;i<shared_segment_count;++i) {
(void) shmctl(shared_ids[i],IPC_RMID,NULL);
}
(void) semctl(system_semaphore,NULL,IPC_RMID,NULL);
/* Kill of other processes too */
for (i=0; i<RUNNING_PROCESSORS(); ++i)
if (i != system_scheduler_number)
kill(SYSTEM_GLOBAL_ARRAY1_VALUE(system_pids,i),SIGQUIT);
exit(n);
}
/*
* Signal fiddling...
*/
#define KICK_SIGNAL (SIGUSR1)
void system_kick_pid(int pid)
{
extern int kill(int,int);
(void) kill(pid,KICK_SIGNAL);
}
static void system_nout()
{
sigset(KICK_SIGNAL,system_nout);
}
void system_sleep_until_kicked()
{
extern int sigpause(int);
(void) my_sigpause(KICK_SIGNAL);
sighold(KICK_SIGNAL);
/*
fprintf(stderr,"{W:%d}\n",system_scheduler_number); fflush(stderr);
*/
fflush(stderr);
}
static void system_read_nout()
{
sigset(KICK_SIGNAL,system_read_nout);
/* GC_sync_test();*/
}
#include <errno.h>
int system_read(int fno,char *buf,int max)
{
int error;
(void) sigset(KICK_SIGNAL,system_read_nout);
do {
error = read(fno,buf,max);
if (error > 0) {
sigset(KICK_SIGNAL,system_nout);
(void) sighold(KICK_SIGNAL);
PROFILE(printf("PVAL:%x\n",PROFILE_TIME(system_local_timer)));
fflush(stdout);
return(error);
}
} while (errno == EINTR);
return(error);
}
void system_kick_sleepers()
{
int i;
for (i=0; i<RUNNING_PROCESSORS(); ++i)
if (i != system_scheduler_number)
kill(SYSTEM_GLOBAL_ARRAY1_VALUE(system_pids,i),KICK_SIGNAL);
}
DEF_PROFILE_TIMER(system_local_timer);
void system_register_process(int n)
{
SYSTEM_GLOBAL_ARRAY1_VALUE(system_pids,n) = getpid();
sigset(KICK_SIGNAL,system_nout);
sighold(KICK_SIGNAL);
INIT_PROFILE_TIMER(system_local_timer);
}
void runtime_initialise_system()
{
#ifdef SEMAPHORES_SYSTEMV
if ((system_semaphore = semget(IPC_PRIVATE,1,511)) < 0) {
perror("INIT ERROR: can't get semaphore\n");
exit(1);
}
if (semctl(system_semaphore,0,SETVAL,1) < 0) {
perror("INIT ERROR: initialise semaphore\n");
exit(1);
}
system_sem_handler_array[0][0].sem_num = 0;
system_sem_handler_array[0][0].sem_op = -1;
system_sem_handler_array[0][0].sem_flg = NULL;
#endif
shared_segment_count = 0;
static_free_ptr = NULL;
static_free_count = 0;
/* Bad news signals */
sigset(SIGTERM,system_abort); /* Catch terminations */
sigset(SIGQUIT,system_abort); /* Quits */
sigset(SIGSEGV,system_abort); /* Segmentation faults */
sigset(SIGBUS,system_abort); /* Bus errors */
/* Error trapped signals */
sigset(SIGINT,system_control_catcher); /* C-c with any luck */
/* Ignore kick signals until we need them */
sighold(KICK_SIGNAL);
#ifdef SEMAPHORES_SOFTWARE
system_semaphore
= (LamportSemaphore)
system_static_malloc(sizeof(struct lamport_semaphore));
lamport_initialise(system_semaphore);
SYSTEM_INITIALISE_GLOBAL_ARRAY1(int,system_pids,MAX_PROCESSORS,0);
SYSTEM_GLOBAL_ARRAY1_VALUE(system_pids,0) = getpid();
#endif
SYSTEM_INITIALISE_GLOBAL(int,system_control_c_flag,FALSE);
}
#endif